home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Code Resources / Eclectic CDEFs / CDEF Utilities / CDEFUtils.p
Encoding:
Text File  |  1997-02-27  |  7.3 KB  |  243 lines  |  [TEXT/PJMM]
  1. {    CDEFUtils    }
  2. {}
  3. {    Miscellaneous utility constants & routines for the CDEFs    }
  4. {}
  5. {    Copyright © Sebastiano Pilla 1996    }
  6. {    All rights reserved    }
  7.  
  8. {    <mailto:case@tvol.it>    }
  9.  
  10. unit CDEFUtils;
  11.  
  12.  
  13. interface
  14.  
  15.  
  16.     uses
  17.         QDOffscreen, Controls;
  18.  
  19.  
  20.     const
  21.         kClearHighByteMask = $80000000;            { For masking out the high bit of inParam on 24-bit addressing }
  22.  
  23.         kBlackPatternIndex = 1;                        { Index of standard black pattern into sysPatListID }
  24.         kWhitePatternIndex = 20;                        { Index of standard white pattern into sysPatListID}
  25.         kGrayPatternIndex = 4;                        { Index of 50% black-50% white pattern into sysPatListID }
  26.  
  27.         kBlackColorRGBComp = $0000;                { R, G, B components of the black color }
  28.         kWhiteColorRGBComp = $FFFF;                { R, G, B components of the white color }
  29.         kDarkGrayColorRGBComp = $4000;            { R, G, B components of the dark gray color }
  30.         kSteelBlueColorRGComp = $CCCC;                { R, G components of the steel blue color }
  31.         kSteelBlueColorBComp = $FFFF;                { B component of the steel blue color }
  32.         kDimGrayColorRGBComp = $7FFF;                { R, G, B components of the gray color used in dimming }
  33.         kChiselGrayColorRGBComp = $AAAA;            { R, G, B components of the gray color for the chisel effect (develop 15) }
  34.         kLightGrayRGBComp = $EEEE;                    { R, G, B components of the light gray color (develop 15) }
  35.         kOpColorRGBComp = $8000;                    { R, G, B components of the color used in addPin, ecc. modes }
  36.  
  37.         kBlackAndWhiteDepth = 1;                        { Depth of a black&white port, in bits per pixel }
  38.         kDeepestDeviceDepth = 0;                        { To use the depth of the deepest device in NewGWorld }
  39.  
  40.         kOffWorldFlags = 0;                            { Flags passed to NewGWorld }
  41.  
  42.         kColorGrafPortMask = $C000;                { Mask applied to portVersion to check for a color port }
  43.  
  44.  
  45. {    SetRGBColor    }
  46. {}
  47. {    Sets the components of a RGBColor to the given values    }
  48. {}
  49. {    Entry:    inRedComp = desired red component    }
  50. {            inGreenComp = desired green component    }
  51. {            inBlueComp = desired blue component    }
  52. {    Exit:    outColor = RGB color with the specified component values    }
  53.     procedure SetRGBColor (var outColor: RGBColor;
  54.                                     inRedComp, inGreenComp, inBlueComp: UInt16);
  55.  
  56.  
  57. {    SetRGBForeColor    }
  58. {}
  59. {    Sets the components of the foreground color    }
  60. {}
  61. {    Entry:    inRedComp = desired red component    }
  62. {            inGreenComp = desired green component    }
  63. {            inBlueComp = desired blue component    }
  64.     procedure SetRGBForeColor (inRedComp, inGreenComp, inBlueComp: UInt16);
  65.  
  66.  
  67. {    SetRGBBackColor    }
  68. {}
  69. {    Sets the components of the background color    }
  70. {}
  71. {    Entry:    inRedComp = desired red component    }
  72. {            inGreenComp = desired green component    }
  73. {            inBlueComp = desired blue component    }
  74.     procedure SetRGBBackColor (inRedComp, inGreenComp, inBlueComp: UInt16);
  75.  
  76.  
  77. {    SetRGBOpColor    }
  78. {}
  79. {    Sets the components for the color used in addPin, ... modes    }
  80. {}
  81. {    Entry:    inRedComp = desired red component    }
  82. {            inGreenComp = desired green component    }
  83. {            inBlueComp = desired blue component    }
  84.     procedure SetRGBOpColor (inRedComp, inGreenComp, inBlueComp: UInt16);
  85.  
  86.  
  87. {    EqualRGBColorComponents    }
  88. {}
  89. {    Checks if all the 3 components of a color match the given value    }
  90. {}
  91. {    Entry:    inColor = color to check    }
  92. {            inComponent = value to check    }
  93. {    Exit:    function result = TRUE if all the 3 color components match the given component, FALSE if at least one    }
  94. {            component is different    }
  95.     function EqualRGBColorComponents (inColor: RGBColor;
  96.                                     inComponent: UInt16): Boolean;
  97.  
  98.  
  99. {    GetControlPortDepth    }
  100. {}
  101. {    Returns the depth of the port owning the specified control    }
  102. {}
  103. {    Entry:    inControlHdl = handle to control    }
  104. {    Exit:    function result = depth of port owning the given control    }
  105.     function GetControlPortDepth (inControlHdl: ControlHandle): UInt16;
  106.  
  107.  
  108. {    CreateControlOffscreenWorld    }
  109. {}
  110. {    Creates and sets up an offscreen graphics world to optimize the drawing of the given control    }
  111. {}
  112. {    Entry:    inControlHdl = handle to control (necessary for contrlRect and contrlOwner)    }
  113. {    Exit:    outOffscreenWorldPtr = pointer to offscreen world (or NIL if errors)    }
  114. {            function result = error code    }
  115.     function CreateControlOffscreenWorld (inControlHdl: ControlHandle;
  116.                                     var outOffscreenWorldPtr: GWorldPtr): OSErr;
  117.  
  118.  
  119. implementation
  120.  
  121.  
  122.     procedure SetRGBColor (var outColor: RGBColor;
  123.                                     inRedComp, inGreenComp, inBlueComp: UInt16);
  124.     begin
  125.         with outColor do
  126.             begin
  127.                 red := inRedComp;
  128.                 green := inGreenComp;
  129.                 blue := inBlueComp;
  130.             end;
  131.     end;
  132.  
  133.  
  134.     procedure SetRGBForeColor (inRedComp, inGreenComp, inBlueComp: UInt16);
  135.         var
  136.             theForeColor: RGBColor;
  137.     begin
  138.         with theForeColor do
  139.             begin
  140.                 red := inRedComp;
  141.                 green := inGreenComp;
  142.                 blue := inBlueComp;
  143.             end;
  144.         RGBForeColor(theForeColor);
  145.     end;
  146.  
  147.  
  148.     procedure SetRGBBackColor (inRedComp, inGreenComp, inBlueComp: UInt16);
  149.         var
  150.             theBackColor: RGBColor;
  151.     begin
  152.         with theBackColor do
  153.             begin
  154.                 red := inRedComp;
  155.                 green := inGreenComp;
  156.                 blue := inBlueComp;
  157.             end;
  158.         RGBBackColor(theBackColor);
  159.     end;
  160.  
  161.  
  162.     procedure SetRGBOpColor (inRedComp, inGreenComp, inBlueComp: UInt16);
  163.         var
  164.             theOpColor: RGBColor;
  165.     begin
  166.         with theOpColor do
  167.             begin
  168.                 red := inRedComp;
  169.                 green := inGreenComp;
  170.                 blue := inBlueComp;
  171.             end;
  172.         OpColor(theOpColor);
  173.     end;
  174.  
  175.  
  176.     function EqualRGBColorComponents (inColor: RGBColor;
  177.                                     inComponent: UInt16): Boolean;
  178.     begin
  179.         with inColor do
  180.             EqualRGBColorComponents := (red = inComponent) & (green = inComponent) & (blue = inComponent);
  181.     end;
  182.  
  183.  
  184.     function GetControlPortDepth (inControlHdl: ControlHandle): UInt16;
  185.     begin
  186.         if BAND(CGrafPtr(inControlHdl^^.contrlOwner)^.portVersion, kColorGrafPortMask) <> 0 then
  187.             GetControlPortDepth := CGrafPtr(inControlHdl^^.contrlOwner)^.portPixMap^^.pixelSize
  188.         else
  189.             GetControlPortDepth := kBlackAndWhiteDepth;
  190.     end;
  191.  
  192.  
  193.     function CreateControlOffscreenWorld (inControlHdl: ControlHandle;
  194.                                     var outOffscreenWorldPtr: GWorldPtr): OSErr;
  195.         var
  196.             controlBounds: Rect;
  197.             savePort: CGrafPtr;
  198.             saveDevice: GDHandle;
  199.             offPMapHdl: PixMapHandle;
  200.             err: OSErr;
  201.     begin
  202.  
  203.     { Save current port and device }
  204.         GetGWorld(savePort, saveDevice);
  205.  
  206.     { Get the control's rectangle: this will become the offscreen world's boundary rectangle }
  207.         controlBounds := inControlHdl^^.contrlRect;
  208.  
  209.     { Create an offscreen world optimized for CopyBits speed by using the depth of the deepest screen }
  210.     { intersecting the control's rectangle }
  211.         err := NewGWorld(outOffscreenWorldPtr, kDeepestDeviceDepth, controlBounds, nil, nil, kOffWorldFlags);
  212.         if err = noErr then
  213.             begin
  214.                 SetGWorld(outOffscreenWorldPtr, nil);
  215.  
  216.         { Move the offscreen world coordinate system to the topLeft corner of the control's rectangle, or all our }
  217.         { future drawing will be in the wrong position! }
  218.                 SetOrigin(controlBounds.left, controlBounds.top);
  219.  
  220.         { Make sure we don't draw outside our GWorld }
  221.                 ClipRect(outOffscreenWorldPtr^.portRect);
  222.  
  223.         { Get the GWorld's pixMap and lock it to draw safely }
  224.                 offPMapHdl := GetGWorldPixMap(outOffscreenWorldPtr);
  225.                 if LockPixels(offPMapHdl) then
  226.                     begin
  227.  
  228.             { Set the default colors, erase the offscreen world and unlock its pixMap }
  229.                         SetRGBForeColor(kBlackColorRGBComp, kBlackColorRGBComp, kBlackColorRGBComp);
  230.                         SetRGBBackColor(kWhiteColorRGBComp, kWhiteColorRGBComp, kWhiteColorRGBComp);
  231.                         SetRGBOpColor(kOpColorRGBComp, kOpColorRGBComp, kOpColorRGBComp);
  232.                         EraseRect(outOffscreenWorldPtr^.portRect);
  233.                         UnlockPixels(offPMapHdl);
  234.                     end;
  235.             end;
  236.  
  237.     { Restore previously saved port and device }
  238.         SetGWorld(savePort, saveDevice);
  239.         CreateControlOffscreenWorld := err;
  240.     end;
  241.  
  242.  
  243. end.